home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / BUFIO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-01  |  12KB  |  384 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Bufio - Buffered File I/O Unit (3-1-89)
  15.  *
  16.  * This unit provides both read and write buffering on block oriented
  17.  * random-access files.  It is optimized for sequential reads or writes,
  18.  * but will function properly with fully random files.
  19.  *
  20.  *)
  21.  
  22. {$i prodef.inc}
  23.  
  24. unit BufIO;
  25.  
  26. interface
  27.    uses DosMem, MdosIO, debugs;
  28.  
  29.    const
  30.       maxbufsiz = $FE00;         {largest file buffer to allocate}
  31.  
  32.    type
  33.       bufarray = array[0..maxbufsiz] of char;
  34.  
  35.       buffered_file = record     {buffered file description record}
  36.          pathname:   dos_filename;  {full name of the file}
  37.          handle:     dos_handle; {handle for dos calls}
  38.          maxrec:     word;       {maximum number of records}
  39.          recsiz:     word;       {record size}
  40.          bufsiz:     word;       {size of the data buffer}
  41.          buffer:     ^bufarray;  {the data buffer}
  42.          fptr:       word;       {base record in file for buffer}
  43.          fnext:      word;       {next record position in buffer (0=first)}
  44.          fcount:     word;       {count of records in buffer}
  45.          dirty:      boolean;    {unsaved changes in buffer?}
  46.          reverse:    boolean;    {reading backwards?}
  47.          readonly:   boolean;    {is file read only?}
  48.       end;
  49.  
  50.  
  51.    var
  52.       berr: boolean;       {true if buffered read or write fails}
  53.  
  54.  
  55.    procedure bcreate(name:    dos_filename);
  56.       {create an empty file; use with bopen to open output files}
  57.  
  58.    procedure bprepare(var bfd:   buffered_file;
  59.                       fd:        dos_handle;
  60.                       maxrecn:   word;
  61.                       recsize:   word);
  62.       {enable buffering on an already open dos_handle}
  63.  
  64.    procedure bXopen(var bfd:   buffered_file;
  65.                    name:      dos_filename;
  66.                    maxrecn:   word;
  67.                    recsize:   word;
  68.                    access:    open_modes);
  69.       {open a buffered file in specified mode}
  70.  
  71.    procedure bopen(var bfd:   buffered_file;
  72.                    name:      dos_filename;
  73.                    maxrecn:   word;
  74.                    recsize:   word);
  75.       {open a buffered file in update mode}
  76.  
  77.    procedure bflush(var bfd:  buffered_file);
  78.       {write buffer, force re-read on next access}
  79.       
  80.    procedure bseek(var bfd:   buffered_file;
  81.                    recn:      word);
  82.       {set position of buffered file}
  83.    
  84.    procedure bseekeof(var bfd:   buffered_file);
  85.       {set position of buffered file to end-of-file}
  86.    
  87.    function btell(var bfd:    buffered_file): word;
  88.       {tell current record number in buffered file}
  89.  
  90.    function beof(var bfd:     buffered_file): boolean;
  91.       {check for eof on buffered file}
  92.  
  93.    procedure bread(var bfd:   buffered_file;
  94.                    var dest);
  95.       {buffered read}
  96.    
  97.    procedure bwrite(var bfd:   buffered_file;
  98.                     var src);
  99.       {buffered write}
  100.  
  101.    procedure bclose(var bfd:  buffered_file);
  102.       {close a buffered file}
  103.  
  104.  
  105.  
  106. implementation
  107.  
  108. (* -------------------------------------------------------- *)
  109.    procedure bcreate(name:    dos_filename);
  110.       {create an empty file}
  111.    begin
  112.       dos_close(dos_create(name));
  113.    end;
  114.  
  115.  
  116. (* -------------------------------------------------------- *)
  117.    procedure bprepare(var bfd:   buffered_file;
  118.                       fd:        dos_handle;
  119.                       maxrecn:   word;
  120.                       recsize:   word);
  121.       {enable buffering on an already open dos_handle}
  122.    var
  123.       limrec:  word;
  124.    begin
  125.       {reduce buffer records if needed to avoid exceeding buffer size limit}
  126.       limrec := maxbufsiz div recsize;
  127.       if maxrecn > limrec then
  128.          maxrecn := limrec;
  129.  
  130.       {initialize the file buffer variables}
  131.       bfd.maxrec := maxrecn;
  132.       bfd.recsiz := recsize;
  133.       bfd.bufsiz := maxrecn*recsize;
  134.       bfd.fcount := 0;
  135.       bfd.fnext := 0;
  136.       bfd.fptr := 0;
  137.       bfd.dirty := false;
  138.       bfd.reverse := true;
  139.  
  140.       {open the file and allocate a buffer for it}
  141.       bfd.handle := fd;
  142.       berr := bfd.handle = dos_error;
  143.       if berr then
  144.          bfd.buffer := nil
  145.       else
  146.          dos_getmem(bfd.buffer, bfd.bufsiz);
  147.  
  148. (****
  149.    if debugging then
  150.       writeln(debugfd^,'bopen: handle=',bfd.handle,
  151.                   ' path=',bfd.pathname,
  152.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  153.                   ' bfd@',seg(bfd),':',ofs(bfd));
  154.  *****)
  155.    end;
  156.  
  157.  
  158. (* -------------------------------------------------------- *)
  159.    procedure bXopen(var bfd:   buffered_file;
  160.                    name:      dos_filename;
  161.                    maxrecn:   word;
  162.                    recsize:   word;
  163.                    access:    open_modes);
  164.       {open a buffered file in specified mode}
  165.    begin
  166.       {open the file and allocate a buffer for it}
  167.       bfd.pathname := name;
  168.       bfd.handle := dos_open(name, access);
  169.       bfd.readonly := (access = open_read);
  170.       bprepare(bfd,bfd.handle,maxrecn,recsize);
  171.    end;
  172.  
  173.  
  174. (* -------------------------------------------------------- *)
  175.    procedure bopen(var bfd:   buffered_file;
  176.                    name:      dos_filename;
  177.                    maxrecn:   word;
  178.                    recsize:   word);
  179.       {open a buffered file in update mode}
  180.    begin
  181.       bXopen(bfd,name,maxrecn,recsize,open_update);
  182.    end;
  183.  
  184.  
  185. (* -------------------------------------------------------- *)
  186.    procedure bflush(var bfd:  buffered_file);
  187.       {save changes in buffer, force re-read on next access}
  188.    begin
  189.       {if file has been written, write buffer contents}
  190.       if bfd.dirty then
  191.       begin
  192.          dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  193.          dos_write(bfd.handle, bfd.buffer^, bfd.recsiz*bfd.fcount);
  194. {if debugging then
  195.    writeln(debugfd^,'...write ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  196.          bfd.dirty := false;
  197.          berr := dos_write_err;
  198.       end
  199.       else
  200.          berr := false;
  201.  
  202.       {adjust physical position in file and empty the buffer}
  203.       inc(bfd.fptr, bfd.fnext);
  204.       bfd.fnext := 0;
  205.       bfd.fcount := 0;
  206.       dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  207.    end;
  208.  
  209.  
  210. (* -------------------------------------------------------- *)
  211.    procedure bseek(var bfd:   buffered_file;
  212.                    recn:      word);
  213.       {set position of buffered file}
  214.    begin
  215.       {reposition within buffer, if possible}
  216.       if (recn >= bfd.fptr) and (recn <= bfd.fptr+bfd.fcount) then
  217.          bfd.fnext := recn - bfd.fptr
  218.       else
  219.       begin
  220.          {save changes, if any}
  221.          if bfd.dirty then
  222.             bflush(bfd);
  223.  
  224.          bfd.reverse := recn < bfd.fptr;
  225.  
  226.          {perform the physical seek}
  227.          bfd.fptr := recn;
  228.          bfd.fnext := 0;
  229.          bfd.fcount := 0;
  230.          dos_rseek(bfd.handle, recn, bfd.recsiz, seek_start);
  231.       end;
  232.    end;
  233.    
  234.  
  235. (* -------------------------------------------------------- *)
  236.    procedure bseekeof(var bfd:   buffered_file);
  237.       {set position of buffered file to end-of-file}
  238.    begin
  239.       {save changes, if any}
  240.       if bfd.dirty then
  241.          bflush(bfd);
  242.  
  243.       dos_lseek(bfd.handle, 0, seek_end);
  244.       bfd.fptr := dos_tell div longint(bfd.recsiz);
  245.       bfd.fnext := 0;
  246.       bfd.fcount := 0;
  247.    end;
  248.    
  249.  
  250. (* -------------------------------------------------------- *)
  251.    function btell(var bfd:    buffered_file): word;
  252.       {tell current record number in buffered file}
  253.    begin
  254.       btell := bfd.fptr+bfd.fnext;
  255.    end;
  256.  
  257.  
  258. (* -------------------------------------------------------- *)
  259.    function beof(var bfd: buffered_file): boolean;
  260.       {check for eof on buffered file}
  261.    var
  262.       cr:   word;
  263.       nr:   word;
  264.       res:  word;
  265.    begin
  266.       {read next block if buffer is empty or exhausted}
  267.       if bfd.fnext >= bfd.fcount then
  268.       begin
  269.  
  270.          {if reading backwards read "lower" in the file than needed}
  271.          if bfd.reverse and (bfd.fcount = 0) then
  272.          begin
  273.             cr := bfd.fptr;            {current base position}
  274.             nr := bfd.maxrec div 4;    {new position for reverse-read}
  275.             if cr > nr then
  276.                bseek(bfd,cr-nr)
  277.             else
  278.                bseek(bfd,0);
  279.  
  280.             bfd.fnext := 0;
  281.             res := dos_read(bfd.handle, bfd.buffer^, bfd.bufsiz);
  282.             bfd.fcount := res div bfd.recsiz;
  283.             bseek(bfd,cr);
  284.          end
  285.          else
  286.  
  287.          begin
  288.             {save changes if buffer has been written}
  289.             if bfd.dirty then
  290.                bflush(bfd);
  291.  
  292.             inc(bfd.fptr,bfd.fcount);
  293.             bfd.fnext := 0;
  294.             res := dos_read(bfd.handle, bfd.buffer^, bfd.bufsiz);
  295.             bfd.fcount := res div bfd.recsiz;
  296.  
  297.    {if debugging then
  298.       writeln(debugfd^,'...read ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  299.          end;
  300.  
  301.          if res = dos_error then
  302.             bfd.fcount := 0;
  303.       end;
  304.  
  305.       {eof if no records left}
  306.       beof := bfd.fcount = 0;
  307.    end;
  308.          
  309.  
  310. (* -------------------------------------------------------- *)
  311.    procedure bread(var bfd:   buffered_file;
  312.                    var dest);
  313.       {buffered read}
  314.    begin
  315.       {check for end of file; read next block when needed}
  316.       berr := beof(bfd);
  317.       if berr then
  318.          exit;
  319.  
  320.       {copy from buffer to user variable}
  321.       move(bfd.buffer^[bfd.fnext*bfd.recsiz], dest, bfd.recsiz);
  322.       inc(bfd.fnext);
  323.    end;
  324.    
  325.  
  326. (* -------------------------------------------------------- *)
  327.    procedure bwrite(var bfd:   buffered_file;
  328.                     var src);
  329.       {buffered write (call dos_write_err to check status)}
  330.    begin
  331.       if bfd.readonly then
  332.       begin
  333.          dos_write_err := true;
  334.          berr := true;
  335.          exit;
  336.       end;
  337.  
  338.       dos_write_err := false;
  339.  
  340.       {save changes if not yet writing or if buffer is full of changes}
  341.       if (not bfd.dirty) or (bfd.fnext >= bfd.maxrec) then
  342.          bflush(bfd)
  343.       else
  344.          berr := false;
  345.  
  346.       {save user variable in buffer and flag it as 'dirty'(unsaved)}
  347.       move(src, bfd.buffer^[bfd.fnext*bfd.recsiz], bfd.recsiz);
  348.       inc(bfd.fnext);
  349.       if bfd.fcount < bfd.fnext then
  350.          inc(bfd.fcount);
  351.       bfd.dirty := true;
  352.    end;
  353.  
  354.  
  355. (* -------------------------------------------------------- *)
  356.    procedure bclose(var bfd:  buffered_file);
  357.       {close a buffered file}
  358.    begin
  359.       if bfd.buffer = nil then
  360.          exit;
  361.  
  362.       if bfd.handle <> dos_error then
  363.       begin
  364.          bflush(bfd);
  365.          dos_close(bfd.handle);              {low-level file close}
  366.       end;
  367.  
  368. (****
  369.     if debugging then
  370.       writeln(debugfd^,'bclose: handle=',bfd.handle,
  371.                   ' path=',bfd.pathname,
  372.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  373.                   ' bfd@',seg(bfd),':',ofs(bfd));
  374.  ****)
  375.  
  376.       dos_freemem(bfd.buffer);    {release buffer memory}
  377.    end;
  378.  
  379.  
  380. {unit initialization}
  381. {begin}
  382. end.
  383.  
  384.